1 Introduction

1.1 Contexte

Les maladies cardiovasculaires représentent la première cause de mortalité dans le monde, avec plus de 17,9 millions de décès annuels selon l’OMS. Ce projet vise à développer un système de prédiction basé sur des données cliniques pour identifier les patients à risque et permettre une intervention précoce.

Source des données : Heart Disease Dataset - Kaggle

Ce dataset provient de plusieurs institutions médicales et contient 303 observations avec 14 attributs cliniques incluant l’âge, le sexe, le type de douleur thoracique, la pression artérielle, le cholestérol et d’autres indicateurs cardiovasculaires.

1.2 Objectifs

  • Objectif 1 : Analyser les facteurs de risque cardiovasculaires et leur distribution
  • Objectif 2 : Développer des modèles prédictifs performants et robustes
  • Objectif 3 : Comparer rigoureusement la régression logistique et le Random Forest
  • Objectif 4 : Déployer une application Shiny interactive pour l’aide à la décision clinique

1.3 Méthodologie

Cette analyse suit une approche scientifique rigoureuse en 5 étapes :

  1. Exploration et nettoyage des données : Traitement des valeurs manquantes, détection des outliers, transformation des variables
  2. Analyse exploratoire visuelle (EDA) : Visualisations interactives pour comprendre les patterns et relations
  3. Modélisation avec validation croisée : Entraînement de modèles avec hyperparamètres optimisés
  4. Évaluation et comparaison des performances : Métriques multiples (Accuracy, Sensibilité, Spécificité, AUC)
  5. Interprétation des résultats : Analyse clinique des facteurs de risque identifiés

2 Configuration de l’Environnement

Cette section installe et charge tous les packages nécessaires pour l’analyse. Nous utilisons le tidyverse pour la manipulation de données, caret pour le machine learning, et plotly pour des visualisations interactives professionnelles.

# Installation et chargement des packages requis
required_packages <- c(
  "tidyverse",    # Manipulation & visualisation
  "caret",        # Machine Learning
  "skimr",        # Exploration des données
  "corrplot",     # Corrélations
  "randomForest", # Modèle Random Forest
  "e1071",        # Support pour caret
  "pROC",         # Courbes ROC / AUC
  "ROCR",         # Visualisation des performances
  "plotly",       # Graphiques interactifs
  "broom",        # Résultats de modèles en dataframes
  "janitor",      # Nettoyage de données
  "knitr",        # Tableaux formatés
  "kableExtra",   # Amélioration des tableaux
  "iml",          # Interprétabilité des modèles
  "reshape2"      # Manipulation de données pour heatmaps
)

# Installation des packages manquants
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages, repos = "http://cran.r-project.org")

# Chargement silencieux
invisible(lapply(required_packages, library, character.only = TRUE))
# Configuration du thème graphique personnalisé
theme_set(theme_minimal(base_size = 12))
palette_custom <- c("#3498db", "#e74c3c")

3 Chargement et Préparation des Données

Cette section gère l’import, le nettoyage et la transformation des données brutes. Nous effectuons un contrôle qualité rigoureux incluant la détection de doublons, la gestion des valeurs aberrantes et la transformation appropriée des variables catégorielles.

3.1 Import des données

# Chargement du dataset
df_raw <- read_csv("heart.csv", show_col_types = FALSE)

# Aperçu des données brutes
glimpse(df_raw)
## Rows: 1,025
## Columns: 14
## $ age      <dbl> 52, 53, 70, 61, 62, 58, 58, 55, 46, 54, 71, 43, 34, 51, 52, 3…
## $ sex      <dbl> 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1…
## $ cp       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 2, 0, 1, 2, 2…
## $ trestbps <dbl> 125, 140, 145, 148, 138, 100, 114, 160, 120, 122, 112, 132, 1…
## $ chol     <dbl> 212, 203, 174, 203, 294, 248, 318, 289, 249, 286, 149, 341, 2…
## $ fbs      <dbl> 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0…
## $ restecg  <dbl> 1, 0, 1, 1, 1, 0, 2, 0, 0, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0, 0…
## $ thalach  <dbl> 168, 155, 125, 161, 106, 122, 140, 145, 144, 116, 125, 136, 1…
## $ exang    <dbl> 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 0…
## $ oldpeak  <dbl> 1.0, 3.1, 2.6, 0.0, 1.9, 1.0, 4.4, 0.8, 0.8, 3.2, 1.6, 3.0, 0…
## $ slope    <dbl> 2, 0, 0, 2, 1, 1, 0, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, 2, 1…
## $ ca       <dbl> 2, 0, 0, 1, 3, 0, 3, 1, 0, 2, 0, 0, 0, 3, 0, 0, 1, 1, 0, 0, 0…
## $ thal     <dbl> 3, 3, 3, 3, 2, 2, 1, 3, 3, 2, 2, 3, 2, 3, 0, 2, 2, 3, 2, 2, 2…
## $ target   <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0…

3.2 Nettoyage et transformation

# Pipeline de nettoyage
heart_clean <- df_raw %>%
  # Nettoyage des noms de colonnes
  clean_names() %>%
  
  # Suppression des doublons stricts
  distinct() %>%
  
  # Transformation des variables catégorielles
  mutate(
    sex = factor(sex, levels = c(0, 1), labels = c("Femme", "Homme")),
    cp = factor(cp, levels = 0:3, labels = c("Type 0", "Type 1", "Type 2", "Type 3")),
    fbs = factor(fbs, levels = c(0, 1), labels = c("Normal", "Élevé")),
    restecg = factor(restecg, levels = 0:2, labels = c("Normal", "Anomalie ST-T", "Hypertrophie")),
    exang = factor(exang, levels = c(0, 1), labels = c("Non", "Oui")),
    slope = factor(slope, levels = 0:2, labels = c("Ascendant", "Plat", "Descendant")),
    ca = factor(ca, levels = 0:4),
    thal = factor(thal, levels = 0:3, labels = c("Normal", "Défaut fixe", "Défaut réversible", "Non testé")),
    target = factor(ifelse(target == 1, "Malade", "Sain"), 
                   levels = c("Sain", "Malade"))
  )

# Rapport de nettoyage
cat(sprintf("
╔═══════════════════════════════════════════════════╗
║          RAPPORT DE NETTOYAGE                     ║
╠═══════════════════════════════════════════════════╣
║ Observations originales    : %5d                  ║
║ Doublons supprimés         : %5d                  ║
║ Observations finales       : %5d                  ║
║ Variables                  : %5d                  ║
╚═══════════════════════════════════════════════════╝
", nrow(df_raw), nrow(df_raw) - nrow(heart_clean), 
   nrow(heart_clean), ncol(heart_clean)))
## 
## ╔═══════════════════════════════════════════════════╗
## ║          RAPPORT DE NETTOYAGE                     ║
## ╠═══════════════════════════════════════════════════╣
## ║ Observations originales    :  1025                  ║
## ║ Doublons supprimés         :   723                  ║
## ║ Observations finales       :   302                  ║
## ║ Variables                  :    14                  ║
## ╚═══════════════════════════════════════════════════╝
# Sauvegarde
saveRDS(heart_clean, "heart_ready.rds")

3.3 Statistiques descriptives

# Résumé statistique
skim(heart_clean) %>%
  select(-skim_type) %>%
  kable(caption = "Statistiques Descriptives Complètes du Dataset") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE,
                font_size = 12)
Statistiques Descriptives Complètes du Dataset
skim_variable n_missing complete_rate factor.ordered factor.n_unique factor.top_counts numeric.mean numeric.sd numeric.p0 numeric.p25 numeric.p50 numeric.p75 numeric.p100 numeric.hist
sex 0 1 FALSE 2 Hom: 206, Fem: 96 NA NA NA NA NA NA NA NA
cp 0 1 FALSE 4 Typ: 143, Typ: 86, Typ: 50, Typ: 23 NA NA NA NA NA NA NA NA
fbs 0 1 FALSE 2 Nor: 257, Éle: 45 NA NA NA NA NA NA NA NA
restecg 0 1 FALSE 3 Ano: 151, Nor: 147, Hyp: 4 NA NA NA NA NA NA NA NA
exang 0 1 FALSE 2 Non: 203, Oui: 99 NA NA NA NA NA NA NA NA
slope 0 1 FALSE 3 Des: 141, Pla: 140, Asc: 21 NA NA NA NA NA NA NA NA
ca 0 1 FALSE 5 0: 175, 1: 65, 2: 38, 3: 20 NA NA NA NA NA NA NA NA
thal 0 1 FALSE 4 Déf: 165, Non: 117, Déf: 18, Nor: 2 NA NA NA NA NA NA NA NA
target 0 1 FALSE 2 Mal: 164, Sai: 138 NA NA NA NA NA NA NA NA
age 0 1 NA NA NA 54.420530 9.047970 29 48.00 55.5 61.00 77.0 ▁▆▇▇▁
trestbps 0 1 NA NA NA 131.602649 17.563394 94 120.00 130.0 140.00 200.0 ▃▇▅▁▁
chol 0 1 NA NA NA 246.500000 51.753489 126 211.00 240.5 274.75 564.0 ▃▇▂▁▁
thalach 0 1 NA NA NA 149.569536 22.903527 71 133.25 152.5 166.00 202.0 ▁▂▅▇▂
oldpeak 0 1 NA NA NA 1.043046 1.161452 0 0.00 0.8 1.60 6.2 ▇▂▁▁▁

4 Analyse Exploratoire (EDA)

Cette section présente une analyse visuelle approfondie des données pour identifier les patterns, relations et facteurs de risque. Toutes les visualisations sont interactives et conçues pour une exploration intuitive des données cliniques.

# Chargement des données nettoyées
heart_data <- readRDS("heart_ready.rds")

# Palette de couleurs professionnelle
colors_target <- c("#3498db", "#e74c3c")
names(colors_target) <- c("Sain", "Malade")

4.1 Distribution de la variable cible

target_summary <- heart_data %>%
  count(target) %>%
  mutate(percentage = round(n/sum(n)*100, 1))

plot_ly(target_summary, 
        x = ~target, 
        y = ~n, 
        type = "bar",
        text = ~paste0(n, " patients<br>", percentage, "%"),
        textposition = "outside",
        marker = list(color = colors_target,
                     line = list(color = "white", width = 2))) %>%
  layout(
    title = list(text = "<b>Répartition des Diagnostics dans la Population Étudiée</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Diagnostic"),
    yaxis = list(title = "Nombre de patients"),
    plot_bgcolor = "#f8f9fa",
    paper_bgcolor = "#ffffff"
  )

4.2 Analyse démographique

4.2.1 Distribution de l’âge

plot_ly(heart_data, 
        x = ~target, 
        y = ~age, 
        color = ~target,
        colors = colors_target, 
        type = "box", 
        boxmean = "sd") %>%
  layout(
    title = list(text = "<b>Distribution de l'Âge selon le Diagnostic</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Diagnostic"),
    yaxis = list(title = "Âge (années)"),
    showlegend = FALSE
  )

4.2.2 Répartition par sexe

sex_data <- heart_data %>%
  group_by(sex, target) %>%
  summarise(count = n(), .groups = "drop") %>%
  group_by(sex) %>%
  mutate(percentage = round(count/sum(count)*100, 1))

plot_ly(sex_data, 
        x = ~sex, 
        y = ~percentage, 
        color = ~target,
        colors = colors_target, 
        type = "bar",
        text = ~paste0(percentage, "%"), 
        textposition = "inside") %>%
  layout(
    barmode = "stack",
    title = list(text = "<b>Proportion de Diagnostics par Sexe</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Sexe"),
    yaxis = list(title = "Pourcentage (%)")
  )

4.3 Analyse des facteurs cliniques

4.3.1 Type de douleur thoracique

cp_data <- heart_data %>%
  group_by(cp, target) %>%
  summarise(count = n(), .groups = "drop")

plot_ly(cp_data, 
        x = ~cp, 
        y = ~count, 
        color = ~target,
        colors = colors_target, 
        type = "bar",
        text = ~count, 
        textposition = "outside") %>%
  layout(
    barmode = "group",
    title = list(text = "<b>Type de Douleur Thoracique et Diagnostic</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Type de douleur thoracique (CP)"),
    yaxis = list(title = "Nombre de patients")
  )

4.3.2 Cholestérol vs Pression artérielle

plot_ly(heart_data, 
        x = ~chol, 
        y = ~trestbps, 
        color = ~target,
        colors = colors_target, 
        type = "scatter", 
        mode = "markers",
        marker = list(size = 8, opacity = 0.6,
                     line = list(color = "white", width = 1)),
        text = ~paste0("Âge: ", age, " ans<br>",
                      "Cholestérol: ", chol, " mg/dl<br>",
                      "Pression: ", trestbps, " mm Hg")) %>%
  layout(
    title = list(text = "<b>Cholestérol vs Pression Artérielle</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Cholestérol (mg/dl)"),
    yaxis = list(title = "Pression artérielle au repos (mm Hg)")
  )

4.3.3 Fréquence cardiaque maximale

plot_ly(heart_data, 
        x = ~thalach, 
        color = ~target,
        colors = colors_target, 
        type = "histogram",
        opacity = 0.7, 
        nbinsx = 30) %>%
  layout(
    barmode = "overlay",
    title = list(text = "<b>Distribution de la Fréquence Cardiaque Maximale</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Fréquence cardiaque maximale (bpm)"),
    yaxis = list(title = "Fréquence")
  )

4.4 Matrice de corrélation

cor_data <- heart_data %>%
  select_if(is.numeric) %>%
  cor(use = "complete.obs")

plot_ly(z = cor_data, 
        x = colnames(cor_data), 
        y = rownames(cor_data),
        type = "heatmap",
        colors = colorRamp(c("#3498db", "#ffffff", "#e74c3c")),
        text = round(cor_data, 2),
        hovertemplate = "Corrélation entre %{x} et %{y}<br>Valeur: %{z:.2f}<extra></extra>") %>%
  layout(
    title = list(text = "<b>Matrice de Corrélation des Variables Numériques</b>",
                 font = list(size = 16)),
    xaxis = list(title = ""),
    yaxis = list(title = "")
  )

5 Modélisation

Cette section présente le développement et l’évaluation de deux approches de machine learning : la régression logistique (modèle interprétable) et le Random Forest (modèle haute performance). Chaque modèle est entraîné avec validation croisée pour assurer la robustesse des résultats.

5.1 Préparation des données

# Chargement des données
heart_data <- readRDS("heart_ready.rds")

# Séparation train/test stratifiée (80/20)
set.seed(123)
split_index <- createDataPartition(heart_data$target, p = 0.80, list = FALSE)
train_data <- heart_data[split_index, ]
test_data  <- heart_data[-split_index, ]

# Prétraitement (normalisation)
preproc_rules <- preProcess(train_data, method = c("center", "scale"))
saveRDS(preproc_rules, "preproc_rules.rds")

# Transformation des données
train_transformed <- predict(preproc_rules, train_data)

# Résumé de la séparation
cat(sprintf("
Données d'entraînement : %d observations (%.1f%%)
Données de test        : %d observations (%.1f%%)
", nrow(train_data), nrow(train_data)/nrow(heart_data)*100,
   nrow(test_data), nrow(test_data)/nrow(heart_data)*100))
## 
## Données d'entraînement : 243 observations (80.5%)
## Données de test        : 59 observations (19.5%)

5.2 Régression Logistique

5.2.1 Entraînement du modèle

# Configuration du contrôle d'entraînement
train_control <- trainControl(
  method = "cv",           # Validation croisée
  number = 10,             # 10 folds
  savePredictions = TRUE,
  classProbs = TRUE
)

# Entraînement
model_logistic <- train(
  target ~ .,
  data = train_data,
  method = "glm",
  family = "binomial",
  metric = "Accuracy",
  trControl = train_control
)

# Résumé du modèle
summary(model_logistic$finalModel)
## 
## Call:
## NULL
## 
## Coefficients:
##                          Estimate Std. Error z value Pr(>|z|)    
## (Intercept)             -0.476826   4.304085  -0.111 0.911787    
## age                      0.031914   0.030217   1.056 0.290901    
## sexHomme                -2.540422   0.733923  -3.461 0.000537 ***
## `cpType 1`               1.135942   0.666290   1.705 0.088217 .  
## `cpType 2`               2.580086   0.649003   3.975 7.02e-05 ***
## `cpType 3`               3.108531   0.929005   3.346 0.000820 ***
## trestbps                -0.031163   0.014376  -2.168 0.030182 *  
## chol                    -0.006395   0.004945  -1.293 0.195963    
## fbsÉlevé                 1.164452   0.782181   1.489 0.136560    
## `restecgAnomalie ST-T`   0.542220   0.480183   1.129 0.258816    
## restecgHypertrophie     -0.887956   3.165726  -0.280 0.779101    
## thalach                  0.034625   0.016439   2.106 0.035180 *  
## exangOui                -1.080917   0.581494  -1.859 0.063047 .  
## oldpeak                 -0.437612   0.293755  -1.490 0.136299    
## slopePlat               -1.380230   1.241491  -1.112 0.266245    
## slopeDescendant          0.035008   1.323315   0.026 0.978894    
## ca1                     -2.477551   0.653870  -3.789 0.000151 ***
## ca2                     -4.426415   1.035257  -4.276 1.91e-05 ***
## ca3                     -1.951556   1.069810  -1.824 0.068121 .  
## ca4                      1.374177   1.830545   0.751 0.452837    
## `thalDéfaut fixe`        3.760582   2.869703   1.310 0.190046    
## `thalDéfaut réversible`  2.612502   2.695061   0.969 0.332362    
## `thalNon testé`          1.176534   2.692850   0.437 0.662176    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 335.05  on 242  degrees of freedom
## Residual deviance: 127.98  on 220  degrees of freedom
## AIC: 173.98
## 
## Number of Fisher Scoring iterations: 7

5.2.2 Évaluation des performances

# Prédictions
pred_log_class <- predict(model_logistic, test_data)
pred_log_prob <- predict(model_logistic, test_data, type = "prob")

# Matrice de confusion
cm_log <- confusionMatrix(pred_log_class, test_data$target, positive = "Malade")
print(cm_log)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Sain Malade
##     Sain     20      4
##     Malade    7     28
##                                           
##                Accuracy : 0.8136          
##                  95% CI : (0.6909, 0.9031)
##     No Information Rate : 0.5424          
##     P-Value [Acc > NIR] : 1.224e-05       
##                                           
##                   Kappa : 0.6211          
##                                           
##  Mcnemar's Test P-Value : 0.5465          
##                                           
##             Sensitivity : 0.8750          
##             Specificity : 0.7407          
##          Pos Pred Value : 0.8000          
##          Neg Pred Value : 0.8333          
##              Prevalence : 0.5424          
##          Detection Rate : 0.4746          
##    Detection Prevalence : 0.5932          
##       Balanced Accuracy : 0.8079          
##                                           
##        'Positive' Class : Malade          
## 
# Courbe ROC
roc_log <- roc(test_data$target, pred_log_prob$Malade)
auc_log <- auc(roc_log)

# Création du dataframe pour plotly
roc_log_df <- data.frame(
  FPR = 1 - roc_log$specificities,
  TPR = roc_log$sensitivities
)

plot_ly(roc_log_df, x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
        line = list(color = '#3498db', width = 3),
        name = 'ROC Curve',
        hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
  add_trace(x = c(0, 1), y = c(0, 1), type = 'scatter', mode = 'lines',
            line = list(color = 'gray', dash = 'dash', width = 2),
            name = 'Ligne de base',
            hoverinfo = 'skip') %>%
  layout(
    title = list(text = sprintf("<b>Courbe ROC - Régression Logistique (AUC = %.3f)</b>", auc_log),
                 font = list(size = 16)),
    xaxis = list(title = "Taux de Faux Positifs (1 - Spécificité)", range = c(0, 1)),
    yaxis = list(title = "Taux de Vrais Positifs (Sensibilité)", range = c(0, 1)),
    showlegend = TRUE,
    hovermode = 'closest'
  )

5.2.3 Interprétation : Facteurs d’influence (Odds Ratios)

# Extraction des Odds Ratios
facteurs_influence <- tidy(model_logistic$finalModel, 
                           exponentiate = TRUE, 
                           conf.int = TRUE) %>%
  filter(term != "(Intercept)") %>%
  arrange(desc(estimate))

# Visualisation avec plotly
plot_ly(facteurs_influence, 
        y = ~reorder(term, estimate), 
        x = ~estimate,
        type = 'scatter',
        mode = 'markers',
        marker = list(size = 12, color = '#e74c3c'),
        error_x = list(
          type = 'data',
          symmetric = FALSE,
          array = ~(conf.high - estimate),
          arrayminus = ~(estimate - conf.low),
          color = '#e74c3c',
          thickness = 2
        ),
        hovertemplate = paste0(
          '<b>%{y}</b><br>',
          'Odds Ratio: %{x:.3f}<br>',
          'IC 95%: [%{error_x.arrayminus:.3f}, %{error_x.array:.3f}]',
          '<extra></extra>'
        )) %>%
  layout(
    title = list(text = "<b>Impact des Facteurs sur le Risque Cardiaque</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Odds Ratio (échelle logarithmique)", type = "log"),
    yaxis = list(title = "Variables cliniques"),
    shapes = list(
      list(type = "line", x0 = 1, x1 = 1, y0 = -0.5, y1 = nrow(facteurs_influence) - 0.5,
           line = list(color = "#3498db", dash = "dash", width = 2))
    )
  )
# Tableau des OR significatifs
facteurs_influence %>%
  filter(p.value < 0.05) %>%
  select(term, estimate, conf.low, conf.high, p.value) %>%
  mutate(across(where(is.numeric), ~round(., 3))) %>%
  kable(caption = "Odds Ratios Significatifs (p < 0.05)",
        col.names = c("Variable", "Odds Ratio", "IC 95% Inf", "IC 95% Sup", "p-value")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)
Odds Ratios Significatifs (p < 0.05)
Variable Odds Ratio IC 95% Inf IC 95% Sup p-value
cpType 3 22.388 4.012 159.355 0.001
cpType 2 13.198 3.938 51.371 0.000
thalach 1.035 1.004 1.072 0.035
trestbps 0.969 0.941 0.996 0.030
ca1 0.084 0.021 0.286 0.000
sexHomme 0.079 0.017 0.307 0.001
ca2 0.012 0.001 0.081 0.000

5.2.4 Sauvegarde du modèle

saveRDS(model_logistic, "final_model_logistic.rds")

5.3 Random Forest

5.3.1 Entraînement du modèle

# Entraînement Random Forest
set.seed(123)
model_rf <- train(
  target ~ .,
  data = train_data,
  method = "rf",
  ntree = 100,
  importance = TRUE,
  metric = "Accuracy",
  trControl = trainControl(method = "cv", number = 5, classProbs = TRUE)
)

print(model_rf)
## Random Forest 
## 
## 243 samples
##  13 predictor
##   2 classes: 'Sain', 'Malade' 
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 195, 195, 193, 195, 194 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa    
##    2    0.8274252  0.6526568
##   12    0.7905136  0.5774063
##   22    0.8030136  0.6026668
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.
saveRDS(model_rf, "final_model_rf.rds")

5.3.2 Importance des variables

# Importance des variables
importance_rf <- varImp(model_rf)

# Extraction et formatage des données d'importance
importance_data <- importance_rf$importance %>%
  as.data.frame() %>%
  tibble::rownames_to_column("Variable") %>%
  rename(Importance = Malade) %>%  # La colonne s'appelle "Malade" dans votre cas
  arrange(desc(Importance))

plot_ly(importance_data, 
        x = ~Importance, 
        y = ~reorder(Variable, Importance),
        type = 'bar',
        orientation = 'h',
        marker = list(color = '#f1c40f',
                     line = list(color = 'white', width = 1)),
        hovertemplate = '<b>%{y}</b><br>Importance: %{x:.2f}<extra></extra>') %>%
  layout(
    title = list(text = "<b>Importance des Variables - Random Forest</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Importance Relative"),
    yaxis = list(title = "")
  )

5.3.3 Évaluation des performances

# Prédictions
pred_rf_class <- predict(model_rf, test_data)
pred_rf_prob <- predict(model_rf, test_data, type = "prob")

# Matrice de confusion
cm_rf <- confusionMatrix(pred_rf_class, test_data$target, positive = "Malade")
print(cm_rf)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Sain Malade
##     Sain     22      6
##     Malade    5     26
##                                           
##                Accuracy : 0.8136          
##                  95% CI : (0.6909, 0.9031)
##     No Information Rate : 0.5424          
##     P-Value [Acc > NIR] : 1.224e-05       
##                                           
##                   Kappa : 0.6255          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.8125          
##             Specificity : 0.8148          
##          Pos Pred Value : 0.8387          
##          Neg Pred Value : 0.7857          
##              Prevalence : 0.5424          
##          Detection Rate : 0.4407          
##    Detection Prevalence : 0.5254          
##       Balanced Accuracy : 0.8137          
##                                           
##        'Positive' Class : Malade          
## 
# Courbe ROC
roc_rf <- roc(test_data$target, pred_rf_prob$Malade)
auc_rf <- auc(roc_rf)

# Création du dataframe pour plotly
roc_rf_df <- data.frame(
  FPR = 1 - roc_rf$specificities,
  TPR = roc_rf$sensitivities
)

plot_ly(roc_rf_df, x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
        line = list(color = '#f1c40f', width = 3),
        name = 'ROC Curve',
        hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
  add_trace(x = c(0, 1), y = c(0, 1), type = 'scatter', mode = 'lines',
            line = list(color = 'gray', dash = 'dash', width = 2),
            name = 'Ligne de base',
            hoverinfo = 'skip') %>%
  layout(
    title = list(text = sprintf("<b>Courbe ROC - Random Forest (AUC = %.3f)</b>", auc_rf),
                 font = list(size = 16)),
    xaxis = list(title = "Taux de Faux Positifs (1 - Spécificité)", range = c(0, 1)),
    yaxis = list(title = "Taux de Vrais Positifs (Sensibilité)", range = c(0, 1)),
    showlegend = TRUE,
    hovermode = 'closest'
  )

6 Comparaison des Modèles

Cette section présente une comparaison rigoureuse et quantitative des deux approches de modélisation. Les métriques de performance sont stockées dans des structures de données professionnelles pour faciliter l’analyse et la prise de décision.

6.1 Métriques de performance

# Création du tableau de comparaison structuré
df_performance <- data.frame(
  Métrique = c("Précision (Accuracy)", "Sensibilité (Recall)", "Spécificité", "AUC-ROC"),
  Régression_Logistique = c(
    cm_log$overall["Accuracy"],
    cm_log$byClass["Sensitivity"],
    cm_log$byClass["Specificity"],
    auc_log
  ),
  Random_Forest = c(
    cm_rf$overall["Accuracy"],
    cm_rf$byClass["Sensitivity"],
    cm_rf$byClass["Specificity"],
    auc_rf
  )
)

# Calcul de la différence de performance
df_performance$Différence <- df_performance$Random_Forest - df_performance$Régression_Logistique

# Formatage et affichage
df_performance %>%
  mutate(across(where(is.numeric), ~round(., 4))) %>%
  kable(caption = "Tableau Comparatif des Performances des Modèles",
        col.names = c("Métrique", "Régression Logistique", "Random Forest", "Δ (RF - RL)"),
        align = c("l", "c", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE,
                font_size = 13) %>%
  column_spec(1, bold = TRUE, width = "10em") %>%
  column_spec(2:4, width = "8em") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")
Tableau Comparatif des Performances des Modèles
Métrique Régression Logistique Random Forest Δ (RF - RL)
Accuracy Précision (Accuracy) 0.8136 0.8136 0.0000
Sensitivity Sensibilité (Recall) 0.8750 0.8125 -0.0625
Specificity Spécificité 0.7407 0.8148 0.0741
AUC-ROC 0.8981 0.9034 0.0052
# Sauvegarde du tableau de performance pour utilisation future
saveRDS(df_performance, "performance_comparison.rds")

# Résumé structuré
performance_summary <- list(
  logistic_regression = list(
    accuracy = cm_log$overall["Accuracy"],
    sensitivity = cm_log$byClass["Sensitivity"],
    specificity = cm_log$byClass["Specificity"],
    auc = auc_log,
    confusion_matrix = cm_log$table
  ),
  random_forest = list(
    accuracy = cm_rf$overall["Accuracy"],
    sensitivity = cm_rf$byClass["Sensitivity"],
    specificity = cm_rf$byClass["Specificity"],
    auc = auc_rf,
    confusion_matrix = cm_rf$table
  ),
  comparison = df_performance
)

saveRDS(performance_summary, "performance_summary.rds")

6.2 Visualisation comparative des métriques

df_plot <- df_performance %>%
  select(-Différence) %>%
  pivot_longer(cols = -Métrique, names_to = "Modèle", values_to = "Valeur") %>%
  mutate(Modèle = ifelse(Modèle == "Régression_Logistique", "Régression Logistique", "Random Forest"))

plot_ly(df_plot, 
        x = ~Métrique, 
        y = ~Valeur, 
        color = ~Modèle, 
        type = "bar",
        colors = c("#3498db", "#f1c40f"),
        text = ~round(Valeur, 3),
        textposition = "outside",
        hovertemplate = '<b>%{x}</b><br>%{data.name}: %{y:.4f}<extra></extra>') %>%
  layout(
    title = list(text = "<b>Comparaison des Performances : Régression Logistique vs Random Forest</b>",
                 font = list(size = 16)),
    yaxis = list(title = "Score", range = c(0, 1.1)),
    xaxis = list(title = ""),
    barmode = 'group',
    hovermode = "x unified",
    legend = list(orientation = "h", x = 0.3, y = -0.15)
  )

6.3 Courbes ROC superposées

# Création des dataframes pour les deux modèles
roc_comparison_df <- rbind(
  data.frame(
    FPR = 1 - roc_log$specificities,
    TPR = roc_log$sensitivities,
    Modèle = "Régression Logistique"
  ),
  data.frame(
    FPR = 1 - roc_rf$specificities,
    TPR = roc_rf$sensitivities,
    Modèle = "Random Forest"
  )
)

plot_ly() %>%
  add_trace(data = filter(roc_comparison_df, Modèle == "Régression Logistique"),
            x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
            name = sprintf('Régression Logistique (AUC = %.3f)', auc_log),
            line = list(color = '#3498db', width = 3),
            hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
  add_trace(data = filter(roc_comparison_df, Modèle == "Random Forest"),
            x = ~FPR, y = ~TPR, type = 'scatter', mode = 'lines',
            name = sprintf('Random Forest (AUC = %.3f)', auc_rf),
            line = list(color = '#f1c40f', width = 3),
            hovertemplate = 'FPR: %{x:.3f}<br>TPR: %{y:.3f}<extra></extra>') %>%
  add_trace(x = c(0, 1), y = c(0, 1), type = 'scatter', mode = 'lines',
            name = 'Ligne de base (AUC = 0.500)',
            line = list(color = 'gray', dash = 'dash', width = 2),
            hoverinfo = 'skip') %>%
  layout(
    title = list(text = "<b>Comparaison des Courbes ROC</b>",
                 font = list(size = 16)),
    xaxis = list(title = "Taux de Faux Positifs (1 - Spécificité)", range = c(0, 1)),
    yaxis = list(title = "Taux de Vrais Positifs (Sensibilité)", range = c(0, 1)),
    showlegend = TRUE,
    legend = list(x = 0.6, y = 0.2),
    hovermode = 'closest'
  )

7 Conclusions et Recommandations

Cette section synthétise les résultats de l’analyse comparative et fournit des recommandations pratiques basées sur les performances observées et les contraintes du contexte clinique.

7.1 Synthèse des résultats

# Chargement du résumé des performances
perf_summary <- readRDS("performance_summary.rds")

cat(sprintf("
╔═══════════════════════════════════════════════════════════════╗
║                    RÉSUMÉ DES PERFORMANCES                     ║
╠═══════════════════════════════════════════════════════════════╣
║                                                                ║
║  RÉGRESSION LOGISTIQUE                                         ║
║  • Précision       : %.1f%%                                    ║
║  • Sensibilité     : %.1f%%                                    ║
║  • Spécificité     : %.1f%%                                    ║
║  • AUC-ROC         : %.3f                                      ║
║  • Avantage        : Interprétabilité clinique (Odds Ratios)   ║
║                                                                ║
║  RANDOM FOREST                                                 ║
║  • Précision       : %.1f%%                                    ║
║  • Sensibilité     : %.1f%%                                    ║
║  • Spécificité     : %.1f%%                                    ║
║  • AUC-ROC         : %.3f                                      ║
║  • Avantage        : Capture des interactions non-linéaires    ║
║                                                                ║
║  MEILLEUR MODÈLE   : %-45s ║
║                                                                ║
╚═══════════════════════════════════════════════════════════════╝
", 
perf_summary$logistic_regression$accuracy * 100,
perf_summary$logistic_regression$sensitivity * 100,
perf_summary$logistic_regression$specificity * 100,
perf_summary$logistic_regression$auc,
perf_summary$random_forest$accuracy * 100,
perf_summary$random_forest$sensitivity * 100,
perf_summary$random_forest$specificity * 100,
perf_summary$random_forest$auc,
ifelse(perf_summary$random_forest$auc > perf_summary$logistic_regression$auc, 
       "Random Forest (performance)", 
       "Régression Logistique (performance)")))
## 
## ╔═══════════════════════════════════════════════════════════════╗
## ║                    RÉSUMÉ DES PERFORMANCES                     ║
## ╠═══════════════════════════════════════════════════════════════╣
## ║                                                                ║
## ║  RÉGRESSION LOGISTIQUE                                         ║
## ║  • Précision       : 81.4%                                    ║
## ║  • Sensibilité     : 87.5%                                    ║
## ║  • Spécificité     : 74.1%                                    ║
## ║  • AUC-ROC         : 0.898                                      ║
## ║  • Avantage        : Interprétabilité clinique (Odds Ratios)   ║
## ║                                                                ║
## ║  RANDOM FOREST                                                 ║
## ║  • Précision       : 81.4%                                    ║
## ║  • Sensibilité     : 81.2%                                    ║
## ║  • Spécificité     : 81.5%                                    ║
## ║  • AUC-ROC         : 0.903                                      ║
## ║  • Avantage        : Capture des interactions non-linéaires    ║
## ║                                                                ║
## ║  MEILLEUR MODÈLE   : Random Forest (performance)                   ║
## ║                                                                ║
## ╚═══════════════════════════════════════════════════════════════╝

7.2 Tableau décisionnel pour le déploiement

# Tableau de recommandations selon le contexte d'utilisation
decision_framework <- data.frame(
  Contexte = c(
    "Dépistage en cabinet médical",
    "Recherche clinique",
    "Application mobile grand public",
    "Système d'aide à la décision hospitalier",
    "Analyse épidémiologique"
  ),
  Modèle_Recommandé = c(
    "Régression Logistique",
    "Random Forest",
    "Random Forest",
    "Hybride (les deux)",
    "Régression Logistique"
  ),
  Justification = c(
    "Interprétabilité pour expliquer au patient",
    "Performance maximale pour essais cliniques",
    "Précision optimale pour recommandations automatiques",
    "Combinaison performance + explicabilité",
    "Identification claire des facteurs de risque populationnels"
  ),
  Priorité_Métrique = c(
    "Spécificité (éviter faux positifs)",
    "AUC-ROC",
    "Sensibilité (détecter tous les cas)",
    "Équilibre Sensibilité/Spécificité",
    "Interprétabilité des coefficients"
  )
)

decision_framework %>%
  kable(caption = "Guide de Sélection du Modèle selon le Contexte Clinique",
        col.names = c("Contexte d'Utilisation", "Modèle Recommandé", 
                      "Justification", "Métrique Prioritaire")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = TRUE,
                font_size = 12) %>%
  column_spec(1, bold = TRUE, width = "12em") %>%
  column_spec(2, width = "10em", background = "#ecf0f1") %>%
  column_spec(3, width = "20em") %>%
  column_spec(4, width = "12em") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#2c3e50")
Guide de Sélection du Modèle selon le Contexte Clinique
Contexte d’Utilisation Modèle Recommandé Justification Métrique Prioritaire
Dépistage en cabinet médical Régression Logistique Interprétabilité pour expliquer au patient Spécificité (éviter faux positifs)
Recherche clinique Random Forest Performance maximale pour essais cliniques AUC-ROC
Application mobile grand public Random Forest Précision optimale pour recommandations automatiques Sensibilité (détecter tous les cas)
Système d’aide à la décision hospitalier Hybride (les deux) Combinaison performance + explicabilité Équilibre Sensibilité/Spécificité
Analyse épidémiologique Régression Logistique Identification claire des facteurs de risque populationnels Interprétabilité des coefficients

7.3 Recommandations pratiques

7.3.1 Déploiement en production

recommendations <- data.frame(
  Catégorie = c(
    "Déploiement Immédiat",
    "Déploiement Immédiat",
    "Amélioration Court Terme",
    "Amélioration Court Terme",
    "Amélioration Moyen Terme",
    "Amélioration Long Terme"
  ),
  Action = c(
    "Utiliser Random Forest pour les prédictions automatiques",
    "Conserver Régression Logistique pour l'explicabilité médicale",
    "Collecter davantage de données (objectif: 1000+ patients)",
    "Implémenter un système de monitoring des prédictions",
    "Optimisation des hyperparamètres (Grid Search, Bayesian Optimization)",
    "Développer un modèle ensemble (stacking RF + RL)"
  ),
  Impact_Attendu = c(
    "Haute précision (AUC > 0.85)",
    "Confiance des cliniciens",
    "Réduction du surapprentissage",
    "Détection de la dérive du modèle",
    "+2-5% de performance",
    "+3-7% de performance"
  ),
  Effort = c("Faible", "Faible", "Moyen", "Moyen", "Élevé", "Élevé")
)

recommendations %>%
  kable(caption = "Feuille de Route pour le Déploiement et l'Amélioration Continue") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = TRUE) %>%
  column_spec(1, bold = TRUE, width = "10em") %>%
  pack_rows("Actions Immédiates", 1, 2, label_row_css = "background-color: #27ae60; color: white;") %>%
  pack_rows("Améliorations à Court Terme (1-3 mois)", 3, 4, 
            label_row_css = "background-color: #f39c12; color: white;") %>%
  pack_rows("Améliorations à Moyen-Long Terme (3-12 mois)", 5, 6, 
            label_row_css = "background-color: #3498db; color: white;")
Feuille de Route pour le Déploiement et l’Amélioration Continue
Catégorie Action Impact_Attendu Effort
Actions Immédiates
Déploiement Immédiat Utiliser Random Forest pour les prédictions automatiques Haute précision (AUC > 0.85) Faible
Déploiement Immédiat Conserver Régression Logistique pour l’explicabilité médicale Confiance des cliniciens Faible
Améliorations à Court Terme (1-3 mois)
Amélioration Court Terme Collecter davantage de données (objectif: 1000+ patients) Réduction du surapprentissage Moyen
Amélioration Court Terme Implémenter un système de monitoring des prédictions Détection de la dérive du modèle Moyen
Améliorations à Moyen-Long Terme (3-12 mois)
Amélioration Moyen Terme Optimisation des hyperparamètres (Grid Search, Bayesian Optimization) +2-5% de performance Élevé
Amélioration Long Terme Développer un modèle ensemble (stacking RF + RL) +3-7% de performance Élevé

7.3.2 Points d’attention critiques

⚠️ Limitations identifiées :

  1. Taille du dataset : 303 observations peuvent limiter la généralisation
  2. Déséquilibre de classes : Vérifier la représentativité des populations
  3. Variables manquantes : Certaines variables cliniques importantes pourraient être absentes
  4. Validation externe : Nécessité de tester sur d’autres populations

✅ Forces du modèle :

  1. Performance robuste : AUC > 0.80 pour les deux modèles
  2. Validation croisée : Résultats stables et reproductibles
  3. Interprétabilité : Facteurs de risque clairement identifiés
  4. Déploiement pratique : Modèles prêts pour intégration Shiny

8 Informations de Session

sessionInfo()
## R version 4.5.2 (2025-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=French_France.utf8  LC_CTYPE=French_France.utf8   
## [3] LC_MONETARY=French_France.utf8 LC_NUMERIC=C                  
## [5] LC_TIME=French_France.utf8    
## 
## time zone: Africa/Lome
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] reshape2_1.4.5       iml_0.11.4           kableExtra_1.4.0    
##  [4] knitr_1.50           janitor_2.2.1        broom_1.0.11        
##  [7] plotly_4.11.0        ROCR_1.0-11          pROC_1.19.0.1       
## [10] e1071_1.7-16         randomForest_4.7-1.2 corrplot_0.95       
## [13] skimr_2.2.1          caret_7.0-1          lattice_0.22-7      
## [16] lubridate_1.9.4      forcats_1.0.1        stringr_1.6.0       
## [19] dplyr_1.1.4          purrr_1.2.0          readr_2.1.6         
## [22] tidyr_1.3.1          tibble_3.3.0         ggplot2_4.0.1       
## [25] tidyverse_2.0.0     
## 
## loaded via a namespace (and not attached):
##  [1] rlang_1.1.6          magrittr_2.0.4       snakecase_0.11.1    
##  [4] compiler_4.5.2       systemfonts_1.3.1    vctrs_0.6.5         
##  [7] crayon_1.5.3         pkgconfig_2.0.3      fastmap_1.2.0       
## [10] backports_1.5.0      rmarkdown_2.30       prodlim_2025.04.28  
## [13] tzdb_0.5.0           bit_4.6.0            xfun_0.54           
## [16] cachem_1.1.0         jsonlite_2.0.0       recipes_1.3.1       
## [19] parallel_4.5.2       R6_2.6.1             bslib_0.9.0         
## [22] stringi_1.8.7        RColorBrewer_1.1-3   parallelly_1.45.1   
## [25] rpart_4.1.24         jquerylib_0.1.4      Rcpp_1.1.0          
## [28] iterators_1.0.14     future.apply_1.20.0  base64enc_0.1-3     
## [31] Metrics_0.1.4        Matrix_1.7-4         splines_4.5.2       
## [34] nnet_7.3-20          timechange_0.3.0     tidyselect_1.2.1    
## [37] rstudioapi_0.17.1    yaml_2.3.11          timeDate_4051.111   
## [40] codetools_0.2-20     listenv_0.10.0       plyr_1.8.9          
## [43] withr_3.0.2          S7_0.2.1             evaluate_1.0.5      
## [46] future_1.68.0        survival_3.8-3       proxy_0.4-27        
## [49] xml2_1.5.1           pillar_1.11.1        checkmate_2.3.3     
## [52] foreach_1.5.2        stats4_4.5.2         generics_0.1.4      
## [55] vroom_1.6.7          hms_1.1.4            scales_1.4.0        
## [58] globals_0.18.0       class_7.3-23         glue_1.8.0          
## [61] lazyeval_0.2.2       tools_4.5.2          data.table_1.17.8   
## [64] ModelMetrics_1.2.2.2 gower_1.0.2          grid_4.5.2          
## [67] crosstalk_1.2.2      ipred_0.9-15         nlme_3.1-168        
## [70] repr_1.1.7           cli_3.6.5            textshaping_1.0.4   
## [73] viridisLite_0.4.2    svglite_2.2.2        lava_1.8.2          
## [76] gtable_0.3.6         sass_0.4.10          digest_0.6.39       
## [79] htmlwidgets_1.6.4    farver_2.1.2         htmltools_0.5.9     
## [82] lifecycle_1.0.4      hardhat_1.4.2        httr_1.4.7          
## [85] bit64_4.6.0-1        MASS_7.3-65

9 Annexes

9.1 Références scientifiques

  • Dataset Source : Heart Disease Dataset - Kaggle
  • Breiman, L. (2001). Random Forests. Machine Learning, 45(1), 5-32.
  • Hosmer, D. W., & Lemeshow, S. (2000). Applied Logistic Regression. Wiley.
  • WHO (2024). Cardiovascular diseases (CVDs) - Fact Sheet.

9.2 Contact et support

Auteurs :
- FEBON S. Daniel
- BODI - SAMA Souweba

Pour toute question sur la méthodologie, les résultats ou l’implémentation :
Veuillez utiliser le système de ticketing du projet ou contacter directement les auteurs.


Note finale : Ce rapport a été généré automatiquement avec R Markdown. Tous les résultats sont reproductibles en exécutant le script source avec les données fournies. Les modèles entraînés sont sauvegardés dans les fichiers .rds pour utilisation ultérieure dans l’application Shiny ou d’autres analyses.